home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 2 / Meeting Pearls Vol. II (1995)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon4Amiga / Dialogs / DialogComboBoxes.Mod (.txt) < prev    next >
Oberon Text  |  1994-11-28  |  12KB  |  274 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. StampElems
  4. Alloc
  5. 2 Nov 94
  6. Syntax10b.Scn.Fnt
  7. MODULE DialogComboBoxes;
  8.     (** Markus Knasm
  9. ller 30 Sep 94 -  
  10.     (* based on PopupElems MF 27.1.92 /MH/CM/MAH/HM *)
  11.     IMPORT
  12.         Bitmaps, DialogCheckBoxes, DialogFrames, DialogListBoxes, Dialogs, DialogSliders, DialogStaticTexts, DialogTexts, 
  13.         Display, Files, Fonts, GraphicUtils, In, Input, MenuViewers, Oberon, Printer, TextFrames, Texts, Viewers;
  14.     CONST
  15.         mhm = 5; mvm = 2;    (*menu: horizontal margin, vertical margin*)
  16.         CR = 0DX; lbH = 100;
  17.         MR = 0; MM = 1; ML = 2; cancel = {ML, MM, MR};
  18.         W* = 60; H* = 22; minH = 20; downW = 9;
  19.         white = 0; grey1 = 12; grey2 = 13; grey3 = 14; black = 15;
  20.     TYPE
  21.         Item* = POINTER TO ItemDesc;
  22.         ItemDesc* = RECORD(Dialogs.ObjectDesc)
  23.             menu*: Texts.Text;    (** text of the list box *)
  24.             readonly*: BOOLEAN;    (** allows changes of the entry field without using the listbox *) 
  25.             selline*: INTEGER;    (** last selected cmd *)
  26.             lbHeight*: INTEGER;    (** height of the listbox *)
  27.             n: INTEGER;        (** number of lines in the text *)
  28.             f: TextFrames.Frame;
  29.         END;
  30.         ChangeMsg = RECORD (Display.FrameMsg);
  31.             x, y: LONGINT;
  32.         END;
  33.     VAR w0: Texts.Writer;
  34.     PROCEDURE Max (x, y: INTEGER): INTEGER;
  35.     BEGIN
  36.         IF x > y THEN RETURN x ELSE RETURN y END
  37.     END Max;
  38.     PROCEDURE (b: Item) Copy* (VAR dup: Dialogs.Object);
  39.     (** allocates dup and makes a deep copy of o. Before calling this methode dup should be equal NIL *)
  40.         VAR x: Item; 
  41.     BEGIN
  42.         IF dup = NIL THEN NEW (x); dup := x ELSE x := dup(Item) END; 
  43.         b.Copy^ (dup); x.menu := TextFrames.Text (""); x.selline := b.selline; x.readonly := b.readonly;
  44.         x.lbHeight := b.lbHeight; x.f := TextFrames.NewText (TextFrames.Text (""), 0);
  45.     END Copy;
  46.     PROCEDURE (b: Item) Load* (VAR r: Files.Rider);
  47.     (** reads the object from rider r *)
  48.     BEGIN b.Load^ (r); Files.ReadBool (r, b.readonly); Files.ReadInt (r, b.lbHeight);
  49.     END Load;
  50.     PROCEDURE (b: Item) Store* (VAR r: Files.Rider);
  51.     (** writes the object to rider r *)
  52.     BEGIN b.Store^ (r); Files.WriteBool (r, b.readonly); Files.WriteInt (r, b.lbHeight);
  53.     END Store;
  54.     (* graphics *)
  55.     PROCEDURE (b: Item) Print* (x, y: INTEGER);
  56.     (** prints the object at printer coordinates (x, y) *)
  57.         VAR h, w, ox, oy, i, p: INTEGER;
  58.     BEGIN  
  59.         b.GetPDim (ox, oy, w, h);
  60.         IF w > h THEN p := h; DEC (w, h) ELSE p := 0 END;
  61.         GraphicUtils.PrintBox (x, y, w, h);
  62.         IF p > SHORT (downW DIV Dialogs.dUnit * Dialogs.pUnit) THEN
  63.             i := (p - SHORT (downW DIV Dialogs.dUnit * Dialogs.pUnit)) DIV 2;
  64.             GraphicUtils.PrintPatternBox (DialogSliders.downArrow, x + w + 1, y, p, p, i, i); 
  65.         END
  66.     END Print;
  67.     PROCEDURE DrawFrame (f1, f: Display.Frame; m: BOOLEAN);
  68.         VAR mode: INTEGER;
  69.     BEGIN
  70.         IF m THEN mode := Display.invert ELSE mode := Display.replace END;
  71.         Display.ReplConstC (f1, black, f.X - 1, f.Y, 1, f.H + 1, mode); Display.ReplConstC (f1, white, f.X + f.W, f.Y, 1, f.H + 1, mode);
  72.         Display.ReplConstC (f1, white, f.X, f.Y, f.W - 1, 1, mode); Display.ReplConstC (f1, black, f.X, f.Y + f.H, f.W - 1, 1, mode)
  73.     END DrawFrame;
  74.     PROCEDURE Adjust (f: TextFrames.Frame; id, dY, y, h: INTEGER);
  75.         VAR m: MenuViewers.ModifyMsg;
  76.     BEGIN
  77.         m.id := id; m.dY := dY; m.Y := y; m.H := 0; f.handle (f, m);
  78.         m.id := id; m.dY := dY; m.Y := y; m.H := h; f.handle (f, m);
  79.     END Adjust; 
  80.     PROCEDURE (b: Item) Draw* (x, y: INTEGER; f: Display.Frame);
  81.     (** displays the object at (x, y) in frame f *)
  82.         VAR ox, oy, w, h, w1, h1, p, i: INTEGER; pat: Display.Pattern;
  83.     BEGIN
  84.         INC (x); b.GetDim (ox, oy, w, h); DEC (w, 2); DEC (h);
  85.         IF w > h THEN p := h; DEC (w, h) ELSE p := 0 END;
  86.         (* checks wether textframe is visible *)
  87.         IF (y + h <= f.Y) OR (y >= f.Y + f.H) OR (x + w <= f.X) OR (x >= f.X + f.W) THEN RETURN END;
  88.         (* corrects x and y such that the lower left coordinats of the textframes are visible *)
  89.         IF (x < f.X) & (x + w > f.X) THEN w := w - (f.X - x); x := f.X END;    
  90.         IF (y < f.Y) & (y + h > f.Y) THEN  h := h- (f.Y - y); y := f.Y END;
  91.         (* corrects wide and height such that the full textframe can be displayed *)
  92.         w1 := f.W - (x - f.X); h1 := f.H - (y - f.Y);
  93.         IF w1 < b.f.left THEN RETURN END;
  94.         IF w > w1 THEN w := w1 END; IF h > h1 THEN h := h1 END;
  95.         IF w < 0 THEN w := 0 END; IF h < 0 THEN h := 0 END;
  96.         b.f.X := x; b.f.Y := y; b.f.W := w; b.f.H := h; 
  97.         Oberon.RemoveMarks (f.X, f.Y, f.W, f.H); DrawFrame (f, b.f, b.selected);
  98.         b.f.barW := 0; b.f.left := 3; b.f.right := 3; b.f.bot := 3; b.f.top := 3;  
  99.         Adjust (b.f, MenuViewers.extend, 0, b.f.Y + 1, b.f.H - 1);
  100.         IF p > downW THEN
  101.             i := (p - downW) DIV 2;
  102.             GraphicUtils.DrawPatternBox (f, FALSE, DialogSliders.downArrow, x + w + 1, y, p, p, i, i, Display.paint); 
  103.         END
  104.     END Draw;
  105.     PROCEDURE (b: Item) Popup (x, y, w, h: INTEGER; f: Display.Frame);    
  106.         VAR 
  107.             menuX, menuY, menuW, menuH, p, i, lsp, dsc, sc, pos1, pos2: INTEGER; t1: Texts.Text;
  108.             r: Texts.Reader; keys: SET; ch: CHAR; bit: Bitmaps.Bitmap;
  109.     BEGIN
  110.         IF w > h THEN p := h ELSE p := 0 END;
  111.         IF p > downW THEN
  112.             i := (p - downW) DIV 2;
  113.             GraphicUtils.DrawPatternBox (f, TRUE, DialogSliders.downArrow, x + w - p + 1, y, p, p, i, i, Display.paint); 
  114.         END;
  115.         menuW := w + 2 * mhm; menuH := Max (b.lbHeight, 40);
  116.         IF y - menuH >= 0 THEN menuY := y - menuH
  117.         ELSIF y + h + menuH <= Display.Height THEN menuY := y + h
  118.         ELSE menuY := 0
  119.         END;
  120.         IF x + menuW <= Display.Width THEN 
  121.             menuX := x
  122.         ELSE 
  123.             menuX := Max (x + w - menuW, 0)
  124.         END;
  125.         Oberon.RemoveMarks (menuX, menuY, menuW, menuH);
  126.         Oberon.FadeCursor (Oberon.Mouse);
  127.         bit := Bitmaps.New (menuW, menuH);
  128.         Bitmaps.CopyBlock (Bitmaps.Disp, bit, menuX, menuY, menuW, menuH, 0, 0, 0); sc := b.selline;
  129.         GraphicUtils.DrawMenu (NIL, b.menu, sc, b.selline, menuX, menuY, menuW, menuH, Display.replace, b.n, lsp, dsc);
  130.         GraphicUtils.TrackMenu (NIL, b.menu, menuX, menuY, menuW, menuH, b.n, lsp, dsc, sc, b.selline);
  131.         Oberon.FadeCursor (Oberon.Mouse);
  132.         Bitmaps.CopyBlock (bit, Bitmaps.Disp, 0, 0, menuW, menuH, menuX, menuY, 0);
  133.         IF p > downW THEN
  134.             i := (p - downW) DIV 2;
  135.             GraphicUtils.DrawPatternBox (f, FALSE, DialogSliders.downArrow, x + w - p + 1, y, p, p, i, i, Display.paint); 
  136.         END;
  137.         IF (b.selline > -1) THEN
  138.             DialogTexts.GetParText (b.par, b.panel, t1); b.CallCmd (f, Viewers.This (x, y), t1);
  139.             GraphicUtils.Set( r, b.menu, b.selline); pos1 := SHORT (Texts.Pos (r));
  140.             WHILE (~ r.eot) & (ch # CR) DO Texts.Read (r, ch) END;
  141.             pos2 := SHORT (Texts.Pos (r));
  142.             Texts.Save (b.menu, pos1, pos2, w0.buf);
  143.             Texts.Delete (b.f.text, 0, b.f.text.len); Texts.Append (b.f.text, w0.buf);
  144.         END;
  145.     END Popup;
  146.     PROCEDURE (b: Item) SetTitle* (t: Texts.Text);
  147.     (** sets the title of the item to t *)
  148.     BEGIN b.f.text := t; b.Restore;
  149.     END SetTitle;
  150.     PROCEDURE (b: Item) GetTitle* (): Texts.Text;
  151.     (** returns the title of the item *)
  152.     BEGIN RETURN b.f.text
  153.     END GetTitle;
  154.     PROCEDURE (b: Item) Handle* (f: Display.Frame; VAR msg: Display.FrameMsg);
  155.     (** handles messages which were sent to frame f *)
  156.         VAR x, y, w, h, p, xh, yh: INTEGER; v: Viewers.Viewer; msg1: Oberon.CopyMsg; 
  157.             f1: Display.Frame; cond: BOOLEAN; msg2: ChangeMsg; t1: Texts.Text;
  158.     BEGIN    
  159.         b.Handle^ (f, msg); b.GetDim (x, y, w, h);
  160.         IF w > h THEN p := h ELSE p := 0 END;
  161.         (* checks textframe is visible *)
  162.         WITH f: DialogFrames.Frame DO
  163.             yh := f.Y + f.H + y; xh := f.X + x; 
  164.             WITH msg: Oberon.InputMsg DO
  165.                 IF (msg.id = Oberon.track) & (p > 0) &
  166.                             (msg.X >= xh + w - p) & (msg.X <= xh + w) & (msg.Y >= yh) & (msg.Y <= yh + h) & (msg.keys # {}) THEN
  167.                     b.Popup (xh, yh, w, h, f);
  168.                     RETURN
  169.                 END
  170.             ELSE
  171.             END;
  172.             IF (yh + h <= f.Y) OR (yh >= f.Y + f.H) OR (xh + w <= f.X) OR (xh >= f.X + f.W) OR (h < minH) THEN RETURN END;
  173.             IF b.readonly THEN RETURN END;
  174.             IF (f.X <= b.f.X) & (f.X + f.W >= b.f.X) & (f.Y <= b.f.Y) & (f.Y + f.H >= b.f.Y) THEN
  175.                 IF msg IS TextFrames.UpdateMsg THEN 
  176.                     IF msg(TextFrames.UpdateMsg).text = b.f.text THEN 
  177.                         b.f.handle (b.f, msg); msg2.x := f.X; msg2.y := f.Y; Viewers.Broadcast (msg2);
  178.                         IF (f.X > b.f.X) OR (f.X + f.W < b.f.X) OR (f.Y > b.f.Y) OR (f.Y + f.H < b.f.Y) THEN
  179.                             b.Draw (f.X + x, f.Y + f.H + y, f); 
  180.                         END;
  181.                         IF b.cmd[0] # 0X THEN 
  182.                             DialogTexts.GetParText (b.par, b.panel, t1);
  183.                             b.CallCmd (f, Viewers.This (xh, yh), t1) 
  184.                         END
  185.                     END 
  186.                 ELSE 
  187.                     b.f.handle (b.f, msg); 
  188.                 END;
  189.             ELSE 
  190.                 cond := FALSE; 
  191.                 WITH msg: Oberon.InputMsg DO 
  192.                     IF (msg.id = Oberon.track) & 
  193.                         (msg.X >= xh) & (msg.X <= xh + w) & (msg.Y >= yh) & (msg.Y <= yh + h) & (msg. keys # {}) THEN cond := TRUE; 
  194.                     END;
  195.                     IF msg.id = Oberon.defocus THEN cond := TRUE END
  196.                 | msg: ChangeMsg DO
  197.                         b.Draw (f.X + x, f.Y + f.H + y, f);
  198.                 ELSE  
  199.                 END;
  200.                 IF cond THEN 
  201.                     TextFrames.RemoveCaret (b.f); b.Draw (f.X + x, f.Y + f.H + y, f); b.f.handle (b.f, msg); 
  202.                 END;
  203.             END
  204.         ELSE
  205.         END; 
  206.     END Handle;
  207.     PROCEDURE (b: Item) Init*;
  208.     (** initialies the object, should be called after allocating the object with NEW *)
  209.     BEGIN 
  210.         b.Init^; b.menu := TextFrames.Text ("");  b.f := TextFrames.NewText (TextFrames.Text (""), 0);
  211.         b.lbHeight := lbH;
  212.     END Init; 
  213.     PROCEDURE WriteToObjectInt (o: DialogTexts.Item; n: INTEGER);
  214.         VAR t: Texts.Text; 
  215.     BEGIN
  216.         t := o.GetText (); Texts.WriteInt (w0, n, 0); Texts.Append (t, w0.buf);
  217.     END WriteToObjectInt;
  218.     PROCEDURE (b: Item) Edit* ();
  219.     (** opens a dialog for editing the properties of the object *)
  220.         VAR on: Dialogs.Object; os, t: DialogTexts.Item; s: DialogStaticTexts.Item; c: DialogCheckBoxes.Item; t1: Texts.Text; fnt: Fonts.Font;
  221.     BEGIN
  222.         b.Edit^; 
  223.         NEW (s); s.Init; s.SetDim (8, -231, 40, 20, FALSE); 
  224.         s.SetString ("lbHeight"); fnt := Fonts.This ("Syntax12b.Scn.Fnt"); s.SetFont (fnt);
  225.         Dialogs.editPanel.Insert (s, FALSE); 
  226.         (* ---- *)  ASSERT (Dialogs.res = Dialogs.ok);
  227.         NEW (t); t.Init; t.SetDim (54, -231, 70, 22, FALSE); t.SetName ("LBh");
  228.         Dialogs.editPanel.Insert (t, FALSE);
  229.         (* ---- *)  ASSERT (Dialogs.res = Dialogs.ok);
  230.         WriteToObjectInt (t, b.lbHeight);
  231.         NEW (c); c.Init; c.SetDim ( 228, -38, 20, 20, FALSE); c.SetName ("RO");
  232.         Dialogs.editPanel.Insert (c, FALSE);
  233.         (* ---- *)  ASSERT (Dialogs.res = Dialogs.ok);
  234.         c.ChangeValue (b.readonly);
  235.         NEW (s); s.Init; s.SetDim (249, -38, 60, 20, FALSE);
  236.         s.SetString ("readonly"); fnt := Fonts.This ("Syntax12b.Scn.Fnt"); s.SetFont (fnt);
  237.         Dialogs.editPanel.Insert (s, FALSE); 
  238.         (* ---- *)  ASSERT (Dialogs.res = Dialogs.ok);
  239.     END Edit;
  240.     PROCEDURE (b: Item) Update* (p: Dialogs.Panel);
  241.     (** sets the properties of the object to the values defined in the dialog p opened with Edit *)
  242.         VAR o: Dialogs.Object; t1: Texts.Text; s: Texts.Scanner; ch: CHAR; str: ARRAY 64 OF CHAR; i: INTEGER;
  243.     BEGIN
  244.         b.Update^ (p); 
  245.         o := p.NamedObject ("LBh"); t1 := o(DialogTexts.Item).GetText ();
  246.         Texts.OpenScanner (s, t1, 0); Texts.Scan (s);
  247.         IF (s.class = Texts.Int) THEN b.lbHeight := SHORT (s.i) ELSE b.lbHeight := lbH END;
  248.         o := p.NamedObject ("RO"); b.readonly := o(DialogCheckBoxes.Item).on;
  249.     END Update;
  250.     PROCEDURE Insert*;
  251.     (** Insert ([name] [x y w h] | ^ ) inserts a combobox - item in the panel containing the caret position *)
  252.         VAR x, y, x1, y1, w, h: INTEGER; b: Item; p: Dialogs.Panel; name: ARRAY 64 OF CHAR; 
  253.     BEGIN 
  254.         NEW (b); 
  255.         DialogFrames.GetCaretPosition (p, x, y);
  256.         IF (p # NIL) THEN 
  257.             b.Init; In.Open; In.Name (name);
  258.             IF ~In.Done THEN COPY ("", name); In.Open END;
  259.             b.SetName (name); 
  260.             In.Int (x1); In.Int (y1); In.Int (w); In.Int (h);
  261.             IF ~In.Done THEN x1 := x; y1 := y; w := W; h := H 
  262.             ELSE
  263.                 IF w < 0 THEN w := W END;
  264.                 IF h < 0 THEN h := H END
  265.             END;
  266.             b.SetDim (x1, y1, w, h, FALSE); p.Insert (b, FALSE) 
  267.         ELSE
  268.             Dialogs.res := Dialogs.noPanelSelected
  269.         END;
  270.         IF Dialogs.res # 0 THEN Dialogs.Error ("DialogComboBoxes") END;
  271.     END Insert;
  272. BEGIN Texts.OpenWriter (w0); 
  273. END DialogComboBoxes.
  274.